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consace par 1B-Sep-1964 25:48:04 YAKeIt BLisg=52 v4. -743, 


MODULE COBSACC_DAY ( 
‘eed = "1-006" ! file: COBACCDAY.B32 Edit:RKR1006 


BEGIN 
' 
i 


— 
'® 

ie COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 

ie DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 

a ALL RIGHTS RESERVED. 

ie THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
ie ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
ie INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 
ie COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
ie OTHER PERSON. NO. TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 
is TRANSFERRED. 

ie THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
i# AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
ix CORPORAT ION. 

ie DIGITAL ASSUMES NO RESPONSIBIL 
is SOFTWARE ON EQUIPMENT WHICH IS N 
i 
iteuceenucnenesucnecasensnsareenccenasucesenessasnanasasnanssnanassenasesss 


555655 
— bd — — — 


— S 
MEUM $OOOBNAULSWN $O OONOUS WOO 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


ITY FOR THE USE OR RELIABILITY OF ITS 


Y 
NOT SUPPLIED BY DIGITAL. 


eaeeneneneneneeeeeeaeneenenannanen 


ise 
FACILITY: COBOL SUPPORT 


ABSTRACT 


i 

i 

i 

i 

i 

i 

ENVIRONMENT: Vax-11 User Mode 

AUTHOR: MLJ , CREATION DATE: 16-JAN-1979 
MODIFIED BY: 
i 

i 

i 

i 

i 

i 

i 

i 

i 

i 


Ww 


MEW OO OONOULS WI OO 


Ssssssssssssssssossss 


1 = Original. MLJ Bh a 1979 
5: Added boile erplate ang comments. RKR 18-JULY-1979 
- Declare peects via acer * RKR 23-AUG-1979 
= Change symbolic name of IBRAR RKR 1-0CT-79 
$ - cosmetic changes. 
- Fix compute ation of number “of days s since O1-JAN so that 
aon utet on does not 8* when this delta is 0. (i.e. 
T-JAN@xxxx). R 11-JAN-81 


et 8 tt 8 a st tt 5 8 st a 4 2 8 8 8 ss 4 HOOD 
. 
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! <BLF /PAGE> 


SIRNIASSELSSPLLES SEL 
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42.1! 


$ep-1984 23:48:04 AX-11 Bliss-32 V4.0-74 Pa 2 
12-800} 98e $3:48:96 YCOBRTL’ SRE COBACCDAY .8352;1 — (2) 


SWITCHES 
SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 


LINKAGES 
NONE 
i TABLE OF CONTENTS: 
FORWARD ROUTINE 
COBSACC_DAY : NOVALUE ; 
! INCLUDE FILES 


REQUIRE 'RTLIN:RTLPSECT’ ; ! Macros for declaring psects 
LIBRARY *RTLSTARLE': 


MACROS 
; NONE 

EQUATED SYMBOLS 

: NONE 

PSECT DECLARATIONS: 
D 


ECLARE_PSECTS (COB) ; ! Psects for COBS facility 


he | Vane 1S }e-1984 2 93:18:36 Feber te SaeScopatcoay 682:1 Page 053 
93 GLOBAL ROUTINE COBSACC_DAY(DST): NOVALUE= 
ise FUNCTIONAL DESCRIPTION 
Returns date as YYDDD 
i FORMAL PARAMETERS: 


1 
| 
| 
| 
i 
4 } 
DST.wt.ds Address of string descriptor to receive date 
IMPLICIT INPUTS: | 
Date as supplied by SASCTIM | 
IMPLICIT OUTPUTS: 
NONE 
i ROUTINE VALUE: 
t COMPLETION CODES: | 
NONE | 
; SIDE EFFECTS: | 
NONE | 
1 | 
: | 
| 
| 
| 


Morr 


RIPIPIPOPIPIPIPYPIPPYPIPOPONINIPYNPIPINININIPYPONY PMIPITOPINPINININININPINININIDY 4 9 9 OO OS OS SS 


REF BLOCKL,BYTE); 
VECTOR 4 
VECTOR 


: BYT j, 
R: Y ‘“ 
SC: VECTORG2), 

SC: VECTOR 
SC: VECTOR ! Descriptor for FAO output 
N; ! Number of days since Ol-Jan 


! Pointer to destination descriptor 


! AE a 

. SBINT 

' Buffer for sacri 

! Buffer for gssenp ing output 
H Rescrister for T 

' Descriptor for FAO control 


Get system date and time. 
SGETTIM(TIMADR=SYSTIM); 


Get time in 64-bit format 


OOVGOOOOSOSOSOSOSOSOSOSOSOS OOOO OOOSOOCOSOOOOCOOOOOOOOOOOOOOOOoOO 


Convert the —* date and time to ASCII. 


Timpesctoy = ! Set up descriptor 
THRmEScEN) = Tlheues TIMADR=SYSTIM); 


ROPIPIPIFIPIPIPDAINIPIPIPIPYPYPINPIPDNOPINPIAPINPIPIPIPDIIYD a nd tt nt a nt at a a ot ot ot 0 — — — — — — —— 
~- @ 
oOo m 
= oe 
— 
oon-—-W cue 2 
, 
wn 
— — . 
mmmmn 25 
fe 
=z 
ow 
cc 
— — 
~_s 
ed 
49 
— — 
oo 
be ie 


Get ASCII representation 


ee Ne OEE CSRS NOC — — oo: 0000 


— — — — — — — — — —— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —— 


FPuw 
20 000 


Save the year of century. 


— — — — — — rt 
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—2* enn HEME GALS | tl 


conversions will leave us with a value of zero. Unfortunately, 
gery is 13 and the following conversion will attempt to 
deal with it as a date, rather than a delta time. To correct for 
this, if the high-order part of the Ants Fi, JANITIM is postive 
we force it negative to insure interpretation as a delta time. 


IF .JANITIMC1) GEQ 0 THEN JANITIMC1) = -1 ; 


! Convert the delta-time value to ASCII. The number of days is then 
one less than the desired Julian date. 


SASCTIM(TIMBUF=TIMDESC, TIMADR=JANITIM); 


1 if BUFFERCO,0,16,0] = .TIMBUFC9,0,16,0); 

4 

4 ! Replace the system date and time by 0l-Jan of the same year and 

rh reconvert to 64-bit format. 

4 Tl IMBUF ° on Ole"; ! h 1- 

8 TABU 3 — dices 
SBINT WinCEIMBUESTIMDESC,” TIMADR=JANITIM); | Reconvert to 64-bit format 
i ! Compute the difference JANITIM = SYSTIM. This yields a delta-time 
¢ selue for the number of days since hy . — 

— — = JAN LS rat0} ~". 81s 1) ir = ,JANITIMC1) = 1; 

28 ANT - .SYSTIMC1 

60 

8 

8 


| 
| 
| 
| 
| 

| 

' 

i 

if J 

JANIT 

JANITIMC1 

If we're dealing with a date of O1-JAN-xx, the above sequence of 

i 

i 


: Convert the number of days to binary. 


N= 0; 

INCR | FROM 0 10 3 DO 
IF .TIMBUFC.1,0,8,0) NEQ %C° ° 
THEN 


N= .N* 10 * .TIMBUFC.1,0,8,0] - %C'0'; 
END; 


— ——— 


22 
wn= 


SSSVEALAN SS SHISASAVSSHGSAL 


— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — —— 


ODOOOSOSOOOCOSOSOSOOCOSOSOSOSOSSOSOSOSCSOOOCODOOCSOSOOOOOOOOOOOOOOOOO 
RoR 


Bo Se Se Se Ge Se Se Ge Fe Se Se Ge Bs Ge Ge Se Se Ge Se Se Se Se Se Ge Ge Se Se Se Se Ss Se Ge Se Se SF Se Se He Se Se Se Se Se Se Se Ge Se Se ee Se Se Se ee 


3s ‘ Convert this value plus one into the output string. | 
CTLDESC 
39 ae 13 UPuiTc* #324" ); | 
39 91 = : Bier 0,0, 03: 
00 3 SFAO(CTL pes oe 
01 9 —XR BUFFER’ a" “s drichin LENGTH], .DSTCDSCSA_POINTER)); 
02 294 1 ENDS 
TITLE COBSACC_DAY 
-IDENT \1-006\ 


22 
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12 
FOBSACC DAY yB-ep-1964 25:48:04 yarn? BLiegcSZ v4-0-742 age 5 


«PSECT _COBSCODE,NOWRT, SHR, PIC,2 


4C SA 33 21 00000 P.AAA: ASCII \!3ZL\ ; 
| 
.EXTRN SYSSGETTIM, SYSSASCTIM | 
-EXTRN SYSSBINTIM, SYSSFAO | 
007¢ 000 .ENTRY COBSACC_DAY, Save R2,R3,R4,R5,R6 : 0185 | 
56 000000006 00 9€ 0000 VAB SYSSASCTIM R6 : 
. Bo OE OF 000 Rove gute SF 0230) 
000000006 00 0 FB 8 CALLS #1, SYSSGETTIM : 
10 AE 17 p 001 MOVL #28, TIMDESC + 0235 
14 AE 20 AE 9FC 901 MOVAB TIMBUF, TIMDESC+4 + 0236 
7E 04 00 CLRL = = (SP) + 0237 
44 AE 9F 000 PUSHAB SYSTIM : 
18 AE 9F 000 PUSHAB TIMDESC F 
7E D4 00028 Ls =(SP) : 
be 04 FB 6662 CALLS #4, SYSSASCTIM : 
18 AE 39 AE BO 0002D VW MBUF+9, BUFFER + 0242 
20 AE 4A2D3730 = BFF D9 0032 MOVL #1266675696 TIMBUF + 0248 
4 7— 4641 BF : 003A VW 033, TIMBUF+ + 0249 
38 AE OOF 9040 PUSHAB JANITIM + 0250 
14 AE 9F 0004 PUSHAB TIMDESC ; 
000000006 00 02 FB 00046 CALLS #2, SYSS$BINTIM ; 
40 AE 38 AE D1 00040 CMPL JANITIM, SYSTIM : 0256 
0 i 0052 BGEQU § 1$ ; 
3c = AEs«é?s:00054 DECL JANITIM+4 : 
38 AE 40 AE «C2 00057 18: SUBL2 SYSTIM, JANITIM : 0257 
C AE 44 AE C2 0005¢ SUBL SYSTINGG, JANITIM+4 : 0258 
04 19 00061 BLSS $ + 0267 
3c AE 1 CE 0063 MNEGL #1, JANITIM+4 ; 
E b4 006 2s: CLRL. = = (§P) + 0272 
3c OE OF 9 69 PUSHAB JANITIM ; 
18 AE 9F 0006C PUSHAB TIMDESC F 
7E 04 006 CLRL. = = (SP) ; 
66 4 FB 00071 CALLS #4, SYSSASCTIM ; 
D4 00074 CLRL OU + 0277 
53 20 AES BR 0078 3$ ROVIBL } MBUFCIJ, R3 : 8 0 
20 53 91 8 CMPB RS UES F 
51 OA te 80 He Pi N,_R1 + 0282 
30 DO A341 § MOVAB mabtnSScRt3, N : 
£9 3 F 4$: AOBLEQ #3, I, 3$ : 0 78 
8 AE 4 ß tt MOVL #4. CTLDESC : 0288 
C AE FF6S = CF : 93 MOVAB P.AAA, CTLDESC+4 + 0289 
6E 03 MOVL =a BUF : 0290 
04 AE 1A AE. -9E 0009 MOVAB BUFFER+2, BUFDESC+4 + 0291 
01 A 3F OOAT PUSHAB 1(N) : 0292 
AE 9F OOOA4 PUSHAB BUFDESC ; 
7E p4 A? CLRL = = (SP) ; 
14 AE 9F OO00A9 PUSHAB CTLDESC : 
000000006 90 04 FB A CALLS #4, SYSSFAO ; 
04 =A p 008 MOVL ost, R : 0293 | 
60 20 18 AE 05 2C 0008 MOVCS #5, BUFFER, #32, (RO), a4(RO) : 


-“m- 


e + 4 data bytes 


Size: 192 
Run Time 8: 
Elapsed T Time : 
Lines/CPuU Min: 
eee Aas tity 33 
ry Us ed: 73 pages 
Compilation Complete 


ee 
win 


SACC_DAY 18.22 “19 74 AX-11 Bliss-32 V4. P 6 | 
83. ge 93:15:90 Hebert Sab Scoaat cnr age. — 
04 69080 : 
04 BF RET 3 0294 | 
: Routine Size: 192 bytes, Routine Base: _COBSCODE + 0004 
5 3 | 
3 $2 $388 0 END ELUDOM 
; PSECT SUMMARY | 
; Name Bytes Attributes 
; _COBSCODE 196 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) | 
; Library Statistics 
Deg ee ahs Symbols -------- Pages Processing 
3 File Total Loaded Percent Mapped Time 
> _$255$DUA28:CSYSLIBISTARLET.L32;1 9776 a 0 581 00:00.8 
: COMMAND QUALIFIERS 
3 FLESS/CHECR SCF TELS. INITIAL COBACCBAY MSRC$: COBACCDAY/UPDATE=(ENHS$: COBACCDAY 
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